10 'PERSONAL COMPUTER AGE PRINTER UTILITY
20 '
30 '
40 '************************************************************************
50 '
60 DEFINT A-Z
70 CLS
80 KEY OFF
90 CLOSE
100 '
110 'DEFINE AND INTIALIZE VARIABLES USED TO PRINT BANNER
120 C =0             ' COLUMN
130 DIM CC(9)        'CHARACTER CODE FOR EACH CHARACTER IN FILE NAME
140 CP=0             'CHARACTER POSITION
150 D=0              'DOT
160 DA=0             'DOT ADDRESS
170 L = 0           ' LENGTH OF FILE NAME
180 M=0              ' MASK
190 DIM PL(131)      'PRINT LINE
200 PS=64            'SYMBOL TO PRINT (64 -@)
210 R=0              'ROW
220 '
230 'DEFINE AND INITALIZE VARIABLES USED TO PRINT THE FILE
240 LINE.CTR=0       'COUNTS LINES ON A PAGE
250 PAGE.CTR=1       'COUNTS PAGES
260 LINES.PG=66      'LINES ON A PAGE, TOTAL
270 LINES.PRT=60     'LINES ON A PAGE, PRINTED
280 FIRST.LINE=1     'FIRST LINE IN FILE TO PRINT
290 LAST.LINE=30000  ' LAST LINE IN FILE TO PRINT
300 CUR.LINE=1       'CURRENT LINE NUMBER (IN FILE) BEING PRINTED
310 '
320 'THE FOLLOWING ARE FLAGS. 1= TRUE, 0= FALSE
330 BANNER=1         'PRINT THE FILE NAME AS A BANNER
340 PRINT.COMP=0     'SET PRINTER TO COMPRESSED MODE
350 '
360 'CONSTANTS
370 FORM.FEED=&HC
380 '
390 '*************************************************************************
400 'PICK UP THE ATTRIBUTES
410 '
420 'FILE NAME
430 ON ERROR GOTO 450
440 GOTO 470             'JUMP OVER ERROR ROUTINE
450 PRINT "THAT FILE DOES NOT EXIST. PLEASE REENTER."
460 RESUME 490
470 PRINT TAB(20) "PRINTER UTILITY":PRINT
480 PRINT "THIS IS A PROGRAM TO PRINT A BANNER FOR A PROGRAM FILE LISTING":PRINT
490 PRINT:LINE INPUT "FILE NAME (INCLUDE EXTENSION): ";FILE.NAME$
500 OPEN FILE.NAME$ FOR INPUT AS #1
510 '
520 'FIRST LINE
530 ON ERROR GOTO 550
540 GOTO 580              'JUMP OVER ERROR MESSAGE
550 RESUME 560
560 PRINT "YOUR RESPONSE MUST BE A NUMBER BETWEEN 1 AND 30000."
570 PRINT "PLEASE REENTER."
580 PRINT:PRINT"FIRST LINE TO PRINT (";FIRST.LINE;"): ";
590 LINE INPUT TEMP$:FIRST.LINE = VAL(TEMP$)
600 IF FIRST.LINE =0 THEN FIRST.LINE =1
610 IF FIRST.LINE<>1 THEN BANNER=0
620 IF (FIRST.LINE <1) OR (FIRST.LINE>30000) THEN GOTO 560
630 '
640 'LAST LINE
650 ON ERROR GOTO 670
660 GOTO 700           'JUMP OVER ERROR MESSAGE
670 RESUME 680
680 PRINT "YOUR RESPONSE MUST BE A NUMBER BETWEEN 1 AND 30000 AND MUST BE"
690 PRINT "GREATER THAN THE FIRST LINE. PLEASE REENTER."
700 PRINT:PRINT "LAST LINE TO PRINT (";LAST.LINE;"): ";
710 LINE INPUT TEMP$: IF TEMP$="" THEN GOTO 730
720 LAST.LINE=VAL(TEMP$)
730 IF LAST.LINE<>30000 THEN BANNER=0
740 IF (LAST.LINE<=FIRST.LINE) OR (LAST.LINE>30000) THEN GOTO 680
750 ON ERROR GOTO 0
760 '
770 'COMPRESSED PRINTING?
780 PRINT:LINE INPUT "COMPRESSED PRINTING? (N): ";TEMP$
790 IF (TEMP$="Y") OR (TEMP$="y") THEN PRINT.COMP =1
800 '
810 'PICK UP FILE DATE
820 DEF SEG
830 DAY=PEEK(VARPTR(#1)+21)
840 YEAR=PEEK(VARPTR(#1)+22)
850 MONTH= ((YEAR AND 1)*8)+((DAY AND 224)/32)
860 MONTH$= MID$(STR$(MONTH),2)
870 YEAR =((YEAR AND 254)/2)+80
880 YEAR$=MID$(STR$(YEAR),2)
890 DAY=DAY AND 31
900 DAY$=MID$(STR$(DAY),2)
910 FILE.DATE$=MONTH$+"/"+DAY$+"/"+YEAR$
920 '
930 'PICK UP FILE NAME, STRIP DEVICE, AND CONVERT TO UPPER CASE
940 L=LEN(FILE.NAME$)
950 FOR I=1 TO LEN(FILE.NAME$)
960      TEMP=ASC(MID$(FILE.NAME$,I,1))
970      IF TEMP = ASC(".") THEN L= I-1
980      IF TEMP = ASC(":") THEN                                                           FILE.NAME$=MID$(FILE.NAME$,(I+1)):GOTO 940
990      IF TEMP > 96 THEN TEMP = TEMP -32
1000      MID$(FILE.NAME$,I,1)=CHR$(TEMP):NEXT I
1010 '
1020 'PRINT THE BANNER
1030 'RESTORE PRINTER DEFAULT CHARACTERISTICS
1040 LPRINT CHR$(20):LPRINT CHR$(27) + "F":LPRINT CHR$(27) +"H"
1050 IF BANNER=0 THEN GOTO 1380
1060 'POINT DATA SEGMENT TO ROM
1070 DEF SEG=&HF000
1080 'SET PRINTER TO COMPRESSED MODE, 132 CHARACTERS PER LINE
1090 LPRINT CHR$(15);:WIDTH "LPT1:",132
1100 'PRINT TOP BORDER
1110 LPRINT:LPRINT:LPRINT:LPRINT STRING$(131,45)
1120 FOR I=0 TO 2:LPRINT STRING$(131,"*"):NEXT I
1130 LPRINT:LPRINT:LPRINT
1140 'INITIALIZE CHARACTER MASK
1150 J=256
1160 FOR I= 1 TO 8
1170      J=J/2:M(I-1)=J
1180      IF I<=L THEN CC(I)=ASC(MID$(FILE.NAME$,I,1))
1190      NEXT I
1200 FOR R=0 TO 7
1210      FOR I= 0 TO 130:PL(I)=32:NEXT I
1220      IF L>7 THEN CP=66-(L*8) ELSE CP=66-(L*9)
1230      FOR X=1 TO L
1240            DA = &HFA6E +(CC(X)*8)
1250            FOR C=0 TO 14 STEP 2
1260                 D=PEEK(DA+R):IF (D AND M(C/2))=0 THEN GOTO 1280
1270                 PL(CP+C)=PS:PL(CP+C+1)=PS
1280                 NEXT C
1290            IF L>7 THEN CP=CP+16 ELSE CP=CP+18:NEXT X
1300      FOR I=0 TO 130:LPRINT CHR$(PL(I));:NEXT I
1310      LPRINT:NEXT R
1320 LPRINT:LPRINT
1330 FOR I=0 TO 2:LPRINT STRING$(131,"*"):NEXT I
1340 LPRINT STRING$(131,45):LPRINT CHR$(18);:WIDTH "LPT1:",80
1350 LPRINT:LPRINT "FILE: "+FILE.NAME$:LPRINT "DATE: "+FILE.DATE$
1360 LPRINT CHR$(FORM.FEED)
1370 '
1380 'PRINT THE FILE
1390 IF PRINT.COMP=1 THEN LPRINT CHR$(15);:WIDTH "LPT1:",132
1400 ON ERROR GOTO 0
1410 'PREPARE PAGE HEADER
1420 SPACES=(70-(LEN(FILE.NAME$)+LEN(FILE.DATE$)))/2
1430 IF PRINT.COMP=1 THEN SPACES =SPACES+26
1440 HEADER$=FILE.DATE$+SPACE$(SPACES)+FILE.NAME$+SPACE$(SPACES)+"PAGE "
1450 'ADVANCE TO FIRST LINE TO PRINT
1460 IF FIRT.LINE=1 THEN GOTO 1510
1470 FOR CUR.LINE=1 TO FIRST.LINE-1
1480     IF EOF(1) THEN GOTO 1640
1490     LINE INPUT #1, TEMP$:NEXT CUR.LINE
1500 '
1510 'PRINT TO LAST LINE
1520       PAGE=1
1530 ON ERROR GOTO 1620
1540 FOR CUR.LINE=FIRST.LINE TO LAST.LINE
1550     IF EOF(1) THEN GOTO 1640
1560     IF LINE.CTR=0 THEN LPRINT HEADER$;PAGE:                                           PAGE=PAGE+1:LINE.CTR = LINE.CTR +4:LPRINT:LPRINT:LPRINT
1570     LINE INPUT #1, TEMP$:LPRINT TEMP$:LINE.CTR=LINE.CTR+1
1580     IF LINE.CTR<LINES.PRT THEN GOTO 1600
1590     LPRINT CHR$(FORM.FEED):LINE.CTR=0
1600     NEXT CUR.LINE
1610  GOTO 1640                 'SKIP OVER TIMEOUT ERROR HANDLING
1620  IF ERR=24 THEN RESUME      'ERROR 24 CAUSED BY DEVICE TIMEOUT
1630  '
1640 'CLEAN UP
1650 LPRINT CHR$(FORM.FEED):LPRINT CHR$(18);:CLOSE #1:SYSTEM
